home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu358.dms / pu358.adf / DonsGenies / Don'sGenies / BordersFrames.pprx < prev    next >
Text File  |  1992-07-16  |  3KB  |  122 lines
  1. /* This Genie puts frames around boxes and sets the margins accordingly.
  2. Written by Don Cox
  3.  */
  4.  
  5. signal on error
  6. signal on syntax
  7. address command
  8. call SafeEndEdit.rexx()
  9. call ppm_AutoUpdate(0)
  10. cr="0a"x
  11.  
  12. counter=0
  13.  
  14. collist = ppm_GetColorList()
  15. collist = substr(collist, pos('0a'x, collist) +1) /* strip off initial line which is number of colours */
  16.  
  17. do forever
  18.     box=ppm_ClickOnBox("Click on boxes to be framed")
  19.     if box=0 then break
  20.     counter=counter+1
  21.     boxes.counter=box
  22.     call ppm_SelectBox(box)
  23. end
  24.  
  25. if counter=0 then exit_msg("No boxes selected")
  26.  
  27. form = "Thickness in Points"cr"Inside/Outside (I/O)"
  28. manylines=ppm_GetForm("Frame settings",4,form)
  29. if manylines="" then exit_msg("Operation Cancelled")
  30.  
  31. parse var manylines weight "0a"x posn
  32. posn= upper(posn)
  33. color=ppm_SelectFromList("Select Color",24,18,0,collist)
  34. if color = "" then exit_msg("Aborted by User")
  35.  
  36. currentunits=ppm_GetUnits()
  37. call ppm_SetUnits(1)
  38.  
  39.  
  40. iw=weight/72   /* line weight in inches */
  41. iw2=iw*2
  42.  
  43. do i=1 to counter
  44.     box=boxes.i
  45.     call ppm_SetBoxFrame(box,1)
  46.     framedata = ppm_GetBoxFrameData(box)
  47.     parse var framedata lc "0a"x fillcolor "0a"x lineweight "0a"x linepattern "0a"x fillpattern  
  48.  
  49.     call ppm_SetBoxFrameData(box,color,fillcolor,weight,linepattern,fillpattern)
  50.     margins = ppm_GetBoxMargins(box)
  51.     parse var margins mleft mtop mright mbottom
  52.  
  53.     ilineweight=lineweight/72
  54.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  55.     if boxtype = "TEXT" then  /* extra margin for text */
  56.         do
  57.         mleft2=abs(mleft-ilineweight+iw)
  58.         if mleft2=iw then mleft2=iw2
  59.         if mleft2<iw then mleft2=iw2
  60.         
  61.         mtop2=abs(mtop-ilineweight+iw)
  62.         if mtop2=iw then mtop2=iw2
  63.         if mtop2<iw then mtop2=iw2
  64.         
  65.         mright2=abs(mright-ilineweight+iw)
  66.         if mright2=iw then mright2=iw2
  67.         if mright2<iw then mright2=iw2
  68.        
  69.         mbottom2=abs(mbottom-ilineweight+iw)
  70.         if mbottom2=iw then mbottom2=iw2
  71.         if mbottom2<iw then mbottom2=iw2
  72.         end
  73.     else
  74.         do
  75.         mleft2 = abs(mleft-ilineweight+iw)
  76.         if mleft2<iw then mleft2=iw
  77.         mtop2=abs(mtop-ilineweight+iw)
  78.         if mtop2<iw then mtop2=iw
  79.         mright2=abs(mright-ilineweight+iw)
  80.         if mright2<iw then mright2=iw
  81.         mbottom2=abs(mbottom-ilineweight+iw)
  82.         if mbottom2<iw then mbottom2=iw
  83.         end
  84.     call ppm_SetBoxMargins(box,mleft2,mtop2,mright2,mbottom2)
  85.  
  86.  
  87.    if posn="O" /* Letter O */
  88.         then do
  89.         where = ppm_GetBoxPosition(box)
  90.         xwhere=word(where,1)
  91.         ywhere=word(where,2)
  92.         call ppm_SetBoxPosition(box,xwhere-iw,ywhere-iw)
  93.         howbig = ppm_GetBoxSize(box)
  94.         boxwidth = word(howbig,1)+iw2
  95.         boxheight = word(howbig,2)+iw2
  96.         call ppm_SetBoxSize(box,boxwidth,boxheight)
  97.         
  98.         end
  99.     end
  100. call ppm_SetUnits(currentunits)
  101.  
  102. call exit_msg()
  103.  
  104. end
  105.  
  106. error:
  107. syntax:
  108.     do
  109.     exit_msg("Genie failed due to error: "errortext(rc))
  110.     end
  111.  
  112. exit_msg:
  113.     do
  114.     parse arg message
  115.     if message ~= "" then
  116.     call ppm_Inform(1,message)
  117.     call ppm_ClearStatus()
  118.     call ppm_AutoUpdate(1)
  119.     exit
  120.     end
  121.  
  122.